﻿#r "System.Xml.dll"
#r "System.Xml.Linq.dll"

open System
open System.Xml.Linq
open System.IO

// Linq to XML helpers
let inline implicit arg =
    (^a : (static member op_Implicit : ^b -> ^a) arg)
let xname : string -> XName = implicit
let xmlns : string -> XNamespace = implicit
let xstr (obj:XObject) =
    match obj with
    | null               -> String.Empty
    | :? XAttribute as a -> a.Value
    | :? XElement as e   -> e.Value
    | obj                -> string obj
let xelem (xn:XNamespace) s (el:XContainer) =
    el.Element(xn + s)
let xelems (xn:XNamespace) s (el:XContainer) =
    el.Elements(xn + s)
let xattr s (el:XElement) =
    match el.Attribute(xname s) with
    | null -> String.Empty
    | a    -> a.Value
let hasValue = not << System.String.IsNullOrEmpty

let xsName    = xmlns "http://www.w3.org/2001/XMLSchema"
let xmlName   = xmlns "http://www.w3.org/XML/1998/namespace"
let xhtmlName = xmlns "http://www.w3.org/1999/xhtml"

let xselem = xelem xsName
let xselems = xelems xsName

let importFile = "XHTML_strict.xsd"
let outputFile = "Xhtml.Generated.fs"

// Converts xs:types to F# types or type names from D.fs
let convertXsType = function
    | "xs:string"
    | "xs:ID"
    | "xs:NMTOKENS"           -> "string"
    | "xs:dateTime"           -> "dateTime"
    | "xs:nonNegativeInteger" -> "int"
    | other                   -> ""

/// Converts a simpleType name from XHTML to a type name from D.fs
let convertSimpleType = function
    | "Character"      -> "character"
    | "Charset"        -> "charset"
    | "Charsets"       -> "charsets"
    | "ContentType"    -> "contentType"
    | "ContentTypes"   -> "contentTypes"
    | "Coords"         -> "coords"
    | "Datetime"       -> "dateTime"
    | "InputType"      -> "inputType"
    | "LanguageCode"   -> "languagecode"
    | "Length"         -> "length"
    | "LinkTypes"      -> "linkTypesMember"
    | "MediaDesc"      -> "mediaDescMember"
    | "MultiLength"    -> "multiLength"
    | "Number"         -> "number"
    | "Pixels"         -> "pixels"
    | "Scope"          -> "scope"
    | "Script"         -> "script"
    | "Shape"          -> "shape"
    | "StyleSheet"     -> "string"    // not found in D.fs
    | "TFrame"         -> "tFrame"
    | "TRules"         -> "tRules"
    | "Text"           -> "text"
    | "URI"            -> "uri"
    | "UriList"        -> "uri list" // not found in D.fs
    | "tabindexNumber" -> "int"      // not found in D.fs
    | other            -> convertXsType other

printfn "%s" "Loading XSD..."
let doc = XDocument.Load(importFile)

type attribute =
    { name     : string;
      required : bool;
      typeName : string }

// TODO: Not currently handling attributes with nested simpleTypes correctly
let parseAttr (attrEl:XElement) =
    { name     = xattr "name" attrEl;
      required = xattr "use"  attrEl = "required";
      typeName = xattr "type" attrEl |> convertSimpleType }

let attrGroups =
    lazy
    (
        let parseAttrGroup (el:XElement) =
            let name  = xattr "name" el
            let attrs = xselems "attribute" el
                        |> Seq.map parseAttr
                        |> List.ofSeq
            (name, attrs)
        doc.Root
        |> xselems "attributeGroup"
        |> Seq.filter (xattr "name" >> hasValue)
        |> Seq.map parseAttrGroup
        |> Map.ofSeq
    )

type ChildRef =
    | ElementRef     of int option * int option * string  // min/max/ref
    | GroupRef       of string
    | AttrGroupRef   of string
    | ComplexTypeRef of string

// all child refs are in xs:choice blocks. Not currently capturing min/max.
let groups =
    lazy
    (
        let parseGroupContent (el:XElement) =
            let ref = xattr "ref" el
            match el.Name.LocalName with
            | "element" -> ElementRef(None, None, ref)
            | "group"   -> GroupRef(ref)
            | _         -> failwithf "Unexpected group content tag: %s" el.Name.LocalName
        let parseGroup (el:XElement) =
            let name = xattr "name" el
            let content = (xselem "choice" el).Elements()
                          |> Seq.map parseGroupContent
                          |> List.ofSeq
            (name, content)
        doc.Root
        |> xselems "group"
        |> Seq.filter (xattr "name" >> hasValue)
        |> Seq.map parseGroup
        |> Map.ofSeq
    )

// all child refs are in xs:choice blocks. Not currently capturing min/max.
let complexTypes =
    lazy
    (
        let parseComplexContent (el:XElement) =
            let ref = xattr "ref" el
            match el.Name.LocalName with
            | "element" -> ElementRef(None, None, ref)
            | "group"   -> GroupRef(ref)
            | _         -> failwithf "Unexpected complexType content tag: %s" el.Name.LocalName
        let parseComplex (el:XElement) =
            let name = xattr "name" el
            let content = (xselem "choice" el).Elements()
                          |> Seq.map parseComplexContent
                          |> List.ofSeq
            (name, content)
        doc.Root
        |> xselems "complexType"
        |> Seq.filter (xattr "name" >> hasValue)
        |> Seq.map parseComplex
        |> Map.ofSeq
    )

type ElementContent =
    | Attribute      of attribute
    | Reference      of ChildRef
    | Section        of Grouping
    | ComplexType    of bool * ElementContent list // mixed/items
    | ComplexContent of ElementContent list
    | Extension      of string * ElementContent list

and Grouping =
    | Sequence of int option * int option * ElementContent list  // min/max/items
    | Choice   of int option * int option * ElementContent list  // min/max/items

let elements =
    let rec parseContent (el:XElement) =
        let getChildren (x:XElement) =
            x.Elements() |> Seq.map parseContent |> List.ofSeq
        let getMinMax (x:XElement) =
            let getOccurs name =
                match (xattr name el) with
                | null | "" | "unbounded" -> None
                | x -> Some(Int32.Parse(x))
            (getOccurs "minOccurs", getOccurs "maxOccurs")
        let getRef = xattr "ref"
        match el.Name.LocalName with
        | "complexType" ->
            let mixed = (xattr "mixed" el = "true")
            ComplexType(mixed, getChildren el)
        | "complexContent" -> 
            ComplexContent(getChildren el)
        | "extension" ->
            let baseType = xattr "base" el
            Extension(baseType, getChildren el)
        | "choice" ->
            let min, max = getMinMax el
            Section(Choice(min, max, getChildren el))
        | "sequence" ->
            let min, max = getMinMax el
            Section(Sequence(min, max, getChildren el))
        | "attribute"  ->
            Attribute(parseAttr el)
        | "attributeGroup" ->
            Reference(AttrGroupRef(getRef el))
        | "element" ->
            let min, max = getMinMax el
            Reference(ElementRef(min, max, getRef el))
        | "group" ->
            Reference(GroupRef(getRef el))
        | other -> failwithf "Unexpected element content tag: %s" other
            
    let parseElement (el:XElement) =
        let name = xattr "name" el
        let content = el.Elements()
                      |> Seq.filter (fun x -> x.Name.LocalName <> "annotation")
                      |> Seq.map parseContent
                      |> List.ofSeq
        (name, content)
    doc.Root
    |> xselems "element"
    |> Seq.map parseElement
    |> Map.ofSeq

let rec lookupRef = function
    | ElementRef(_,_,r) -> elements.[r]
    | GroupRef(r)       -> groups.Value.[r]       |> List.collect lookupRef
    | AttrGroupRef(r)   -> attrGroups.Value.[r]   |> List.map Attribute
    | ComplexTypeRef(r) -> complexTypes.Value.[r] |> List.collect lookupRef

let rec getElementAttributes element =
    match element with
    | Attribute(attr)         -> [attr]
    | Reference(ref)          -> 
        lookupRef ref 
        |> List.collect getElementAttributes
    | Section(Sequence(_,_,content)) 
    | Section(Choice(_,_,content))
    | ComplexType(_,content)
    | ComplexContent(content)
    | Extension(_,content)    -> 
        content |> List.collect getElementAttributes

// Looking at the XSD, it seems an element can have children if it is "complexType mixed=true"
// or if we can find an ElementRef under it somewhere.


let elementHasChildren content = 
    let rec hasChildren = function
        | ComplexType(mixed, nested)  ->
            try
                if mixed then true
                else nested |> List.exists hasChildren
            with
                // <area>, <base>, <body> tags get a null reference error.
                // Seems possible it's a framework bug. Re-test in F# 2.0
                | :? System.NullReferenceException -> false
        | Reference(ElementRef(_,_,_)) -> true
        | Reference(GroupRef(group))   ->
            groups.Value.[group]
            |> Seq.map Reference
            |> Seq.exists hasChildren
        | Reference(ComplexTypeRef(name)) ->
            complexTypes.Value.[name]
            |> Seq.map Reference
            |> Seq.exists hasChildren
        | ComplexContent(nested)
        | Section(Sequence(_,_,nested))
        | Section(Choice(_,_,nested))   ->
            nested |> List.exists hasChildren
        | Extension(name, nested) ->
            complexTypes.Value.[name] 
            |> Seq.map Reference
            |> Seq.append nested
            |> Seq.exists hasChildren
        | _ -> false
    
    content |> List.exists hasChildren

(*
let containers, empties =
    let c, e =
        elements 
        |> Map.toList 
        |> List.partition (fun (key, parts) -> elementHasChildren parts)
    (c |> List.map fst |> Set.ofList, e |> List.map fst |> Set.ofList)
*)

let empties = Set.ofList ["base";"meta";"link";"hr";"br";"param";"img";"area";"input";"col"]

let capitalize (str:string) = (str.[0..0].ToUpper()) + str.[1..]

let writer = File.CreateText(outputFile)
try
    let writef                 = fprintf writer
    let writefn                = fprintfn writer
    let write      (s:string)  = writer.Write(s)
    let writen     (s:string)  = writer.WriteLine(s)

    let doc        = fprintfn writer "        /// Generates <%s> tag."
    let containerA = fprintfn writer "        member this.%s (attrs) : #seq<Node> -> Node = this.ContainerNode \"%s\" attrs"
    let containerI = fprintfn writer "        member this.%s (inner:#seq<Node>) : Node = this.ContainerNode \"%s\" [] inner"
    let containerC = fprintfn writer "        member this.%s (creators) : #seq<Node> -> Node = this.ContainerNodeCss \"%s\" creators"
    let docEmpty   = fprintfn writer "        /// Generates <%s /> tag."
    let emptyA     = fprintfn writer "        member this.%s (attrs) = this.EmptyNode \"%s\" attrs"
    let emptyC     = fprintfn writer "        member this.%s (creators) = this.EmptyNodeCss \"%s\" creators"
    let empty      = fprintfn writer "        member this.%s () = this.EmptyNode \"%s\" []"

    let elementTypeToMembers s =
        let S = capitalize s
        if empties.Contains s then
            printf "%s (empty), " s
            docEmpty s
            emptyA S s
            docEmpty s
            emptyC S s
            docEmpty s
            empty  S s
        else
            printf "%s (container), " s
            doc s
            containerA S s
            doc s
            containerI S s
            doc s
            containerC S s

    writen "// This file is auto-generated. Please re-generate with Generator.fsx"
    writen "namespace WingBeats.Xhtml"
    writen "[<AutoOpen>]"
    writen "module Generated ="
    writen "    open WingBeats.Xml"

    writen "    type WingBeats.Xhtml.XhtmlElement with"

    elements 
    |> Map.toSeq 
    |> Seq.map fst 
    |> Seq.iter elementTypeToMembers

    let html5Tags = ["audio";"canvas";"embed";"video"]

    writen ""
    writen ""
    writen "/// Adds non-standard tag extensions to XhtmlElement, such as embed or canvas."
    writen "module Ext ="
    writen "    open WingBeats.Xml"
    writen "    type WingBeats.Xhtml.XhtmlElement with"

    html5Tags
    |> List.iter elementTypeToMembers

    ()
finally
    writer.Flush()
    writer.Close()